home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / buffered-input.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  4.7 KB  |  113 lines
  1. ;;;; buffered-input.scm --- construct a port from a buffered input reader
  2. ;;;;
  3. ;;;;     Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  4. ;;;; 
  5. ;;;; This library is free software; you can redistribute it and/or
  6. ;;;; modify it under the terms of the GNU Lesser General Public
  7. ;;;; License as published by the Free Software Foundation; either
  8. ;;;; version 2.1 of the License, or (at your option) any later version.
  9. ;;;; 
  10. ;;;; This library is distributed in the hope that it will be useful,
  11. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;;;; Lesser General Public License for more details.
  14. ;;;; 
  15. ;;;; You should have received a copy of the GNU Lesser General Public
  16. ;;;; License along with this library; if not, write to the Free Software
  17. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18.  
  19. (define-module (ice-9 buffered-input)
  20.   #:export (make-buffered-input-port
  21.             make-line-buffered-input-port
  22.             set-buffered-input-continuation?!))
  23.  
  24. ;; @code{buffered-input-continuation?} is a property of the ports
  25. ;; created by @code{make-line-buffered-input-port} that stores the
  26. ;; read continuation flag for each such port.
  27. (define buffered-input-continuation? (make-object-property))
  28.  
  29. (define (set-buffered-input-continuation?! port val)
  30.   "Set the read continuation flag for @var{port} to @var{val}.
  31.  
  32. See @code{make-buffered-input-port} for the meaning and use of this
  33. flag."
  34.   (set! (buffered-input-continuation? port) val))
  35.  
  36. (define (make-buffered-input-port reader)
  37.   "Construct a line-buffered input port from the specified @var{reader}.
  38. @var{reader} should be a procedure of one argument that somehow reads
  39. a chunk of input and returns it as a string.
  40.  
  41. The port created by @code{make-buffered-input-port} does @emph{not}
  42. interpolate any additional characters between the strings returned by
  43. @var{reader}.
  44.  
  45. @var{reader} should take a boolean @var{continuation?} argument.
  46. @var{continuation?} indicates whether @var{reader} is being called to
  47. start a logically new read operation (in which case
  48. @var{continuation?} is @code{#f}) or to continue a read operation for
  49. which some input has already been read (in which case
  50. @var{continuation?} is @code{#t}).  Some @var{reader} implementations
  51. use the @var{continuation?} argument to determine what prompt to
  52. display to the user.
  53.  
  54. The new/continuation distinction is largely an application-level
  55. concept: @code{set-buffered-input-continuation?!} allows an
  56. application to specify when a read operation is considered to be new.
  57. But note that if there is non-whitespace data already buffered in the
  58. port when a new read operation starts, this data will be read before
  59. the first call to @var{reader}, and so @var{reader} will be called
  60. with @var{continuation?} set to @code{#t}."
  61.   (let ((read-string "")
  62.     (string-index -1))
  63.     (letrec ((get-character
  64.           (lambda ()
  65.         (cond 
  66.          ((eof-object? read-string)
  67.           read-string)
  68.          ((>= string-index (string-length read-string))
  69.           (set! string-index -1)
  70.                   (get-character))
  71.          ((= string-index -1)
  72.           (set! read-string (reader (buffered-input-continuation? port)))
  73.                   (set! string-index 0)
  74.                   (if (not (eof-object? read-string))
  75.                       (get-character)
  76.                       read-string))
  77.          (else
  78.           (let ((res (string-ref read-string string-index)))
  79.             (set! string-index (+ 1 string-index))
  80.                     (if (not (char-whitespace? res))
  81.                         (set! (buffered-input-continuation? port) #t))
  82.             res)))))
  83.          (input-waiting
  84.           (lambda ()
  85.         (if (eof-object? read-string)
  86.             1
  87.             (- (string-length read-string) string-index))))
  88.              (port #f))
  89.       (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r"))
  90.       (set! (buffered-input-continuation? port) #f)
  91.       port)))
  92.  
  93. (define (make-line-buffered-input-port reader)
  94.   "Construct a line-buffered input port from the specified @var{reader}.
  95. @var{reader} should be a procedure of one argument that somehow reads
  96. a line of input and returns it as a string @emph{without} the
  97. terminating newline character.
  98.  
  99. The port created by @code{make-line-buffered-input-port} automatically
  100. interpolates a newline character after each string returned by
  101. @var{reader}.
  102.  
  103. @var{reader} should take a boolean @var{continuation?} argument.  For
  104. the meaning and use of this argument, see
  105. @code{make-buffered-input-port}."
  106.   (make-buffered-input-port (lambda (continuation?)
  107.                               (let ((str (reader continuation?)))
  108.                                 (if (eof-object? str)
  109.                                     str
  110.                                     (string-append str "\n"))))))
  111.  
  112. ;;; buffered-input.scm ends here
  113.